home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / slib / plottest.scm < prev    next >
Encoding:
Text File  |  1994-05-25  |  1.3 KB  |  48 lines
  1. ;"plottest.scm" test charplot.scm
  2. ;Copyright (C) 1992 Aubrey Jaffer
  3. ;
  4. ;Permission to copy this software, to redistribute it, and to use it
  5. ;for any purpose is granted, subject to the following restrictions and
  6. ;understandings.
  7. ;
  8. ;1.  Any copy made of this software must include this copyright notice
  9. ;in full.
  10. ;
  11. ;2.  I have made no warrantee or representation that the operation of
  12. ;this software will be error-free, and I am under no obligation to
  13. ;provide any services, by way of maintenance, update, or otherwise.
  14. ;
  15. ;3.  In conjunction with products arising from the use of this
  16. ;material, there shall be no use of my name in any advertising,
  17. ;promotional, or sales literature without prior written consent in
  18. ;each case.
  19.  
  20. (require 'charplot)
  21. (require 'random)
  22.  
  23. (define strophoid
  24.   (let ((l '()))
  25.     (do ((x -1.0 (+ x 0.05)))
  26.     ((> x 4.0))
  27.       (let* ((a (/ (- 2 x) (+ 2 x))))
  28.     (if (>= a 0.0)
  29.         (let* ((y (* x (sqrt a))))
  30.           (set! l (cons (cons x y) l))
  31.           (set! l (cons (cons x (- y)) l))))))
  32.     l))
  33.  
  34. (plot! strophoid "x" "y") (newline)
  35.  
  36. (define unif
  37.   (let* ((l 6)
  38.      (v (make-vector l)))
  39.     (do ((i (- l 1) (- i 1)))
  40.     ((negative? i))
  41.       (vector-set! v i (cons i 0)))
  42.     (do ((i 24 (- i 1))
  43.      (r (random l) (random l)))
  44.     ((zero? i) (vector->list v))
  45.       (set-cdr! (vector-ref v r) (+ 1 (cdr (vector-ref v r)))))))
  46.  
  47. (plot! unif "n" "occur")
  48.